home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / editors / emcs1857 / 1857sr~1.zoo / lisp / char-table.el < prev    next >
Encoding:
Text File  |  1992-01-24  |  5.1 KB  |  181 lines
  1. ;; Functions for dealing with char tables.
  2. ;; Copyright (C) 1987 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is distributed in the hope that it will be useful,
  7. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  8. ;; accepts responsibility to anyone for the consequences of using it
  9. ;; or for whether it serves any particular purpose or works at all,
  10. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  11. ;; License for full details.
  12.  
  13. ;; Everyone is granted permission to copy, modify and redistribute
  14. ;; GNU Emacs, but only under the conditions described in the
  15. ;; GNU Emacs General Public License.   A copy of this license is
  16. ;; supposed to have been given to you along with GNU Emacs so you
  17. ;; can know your rights and responsibilities.  It should be in a
  18. ;; file named COPYING.  Among other things, the copyright notice
  19. ;; and this notice must be preserved on all copies.
  20.  
  21.  
  22. ;; Written by Howard Gayle.  See case-table.el for details.
  23.  
  24. (require 'case-table)
  25.  
  26. (defun buffer-ctl-arrow-off ()
  27.    "Display control characters as \\ number in curent buffer.
  28. Does not change existing windows."
  29.    (interactive)
  30.    (setq buffer-char-table (backslash-char-table))
  31. )
  32.  
  33. (defun buffer-ctl-arrow-on ()
  34.    "Display control characters as ^ character in curent buffer.
  35. Does not change existing windows."
  36.    (interactive)
  37.    (setq buffer-char-table (ctl-arrow-char-table))
  38. )
  39.  
  40. (defun ctl-arrow-off ()
  41.    "Display control characters as \\ number in selected window."
  42.    (interactive)
  43.    (set-window-char-table (backslash-char-table))
  44. )
  45.  
  46. (defun ctl-arrow-on ()
  47.    "Display control characters as ^ character in selected window."
  48.    (interactive)
  49.    (set-window-char-table (ctl-arrow-char-table))
  50. )
  51.  
  52. (defun default-ctl-arrow-off ()
  53.    "By default, display control characters as \\ number."
  54.    (interactive)
  55.    (setq-default buffer-char-table (backslash-char-table))
  56. )
  57.  
  58. (defun default-ctl-arrow-on ()
  59.    "By default, display control characters as ^ character."
  60.    (interactive)
  61.    (setq-default buffer-char-table (ctl-arrow-char-table))
  62. )
  63.  
  64. (defun describe-char-table (ct)
  65.    "Describe the given char table in a help buffer."
  66.    (let  (
  67.            (i 0) ; Current character.
  68.      j     ; Rope index.
  69.      r     ; Rope.
  70.      )
  71.       (with-output-to-temp-buffer "*Help*"
  72.      (princ "Frame glyf: ")
  73.      (prin1 (glyf-to-string (get-char-table-frameg ct)))
  74.      (princ "\nTruncation glyf: ")
  75.      (prin1 (glyf-to-string (get-char-table-truncg ct)))
  76.      (princ "\nWrap glyf: ")
  77.      (prin1 (glyf-to-string (get-char-table-wrapg ct)))
  78.            (princ "\nSelective display character: ")
  79.      (describe-character (get-char-table-invisc ct))
  80.      (princ "\nSelective display rope: ")
  81.      (setq r (get-char-table-invisr ct))
  82.      (setq j 0)
  83.      (while (< j (length r))
  84.         (aset r j (glyf-to-string (aref r j)))
  85.         (setq j (1+ j))
  86.      )
  87.      (prin1 r)
  88.      (princ "\n\nCharacter ropes:\n")
  89.      (while (<= i 255)
  90.         (describe-character i)
  91.         (princ "\t")
  92.         (setq r (get-char-table-dispr ct i))
  93.         (setq j 0)
  94.         (while (< j (length r))
  95.            (aset r j (glyf-to-string (aref r j)))
  96.            (setq j (1+ j))
  97.         )
  98.         (prin1 r)
  99.         (princ "\n")
  100.         (setq i (1+ i))
  101.      )
  102.      (print-help-return-message)
  103.       )
  104.    )
  105. )
  106.  
  107. (defun describe-window-char-table ()
  108.    "Describe the char table of the selected window."
  109.    (interactive)
  110.    (describe-char-table (window-char-table (selected-window)))
  111. )
  112.  
  113. (defun standard-chars-8bit (l h)
  114.    "Display characters in the range [L, H] with their actual
  115. values in backslash-char-table and ctl-arrow-char-table."
  116.    (let     (r)
  117.       (while (<= l h)
  118.            (setq r (vector (new-glyf (char-to-string l))))
  119.      (put-char-table-dispr (backslash-char-table) l r)
  120.      (put-char-table-dispr (ctl-arrow-char-table) l r)
  121.      (setq l (1+ l))
  122.       )
  123.       r
  124.    )
  125. )
  126.  
  127. (defun standard-char-ascii (c s)
  128.    "Display character C with string S in
  129.    backslash-char-table and ctl-arrow-char-table."
  130.    (let     ((r (string-to-rope s)))
  131.       (put-char-table-dispr (backslash-char-table) c r)
  132.       (put-char-table-dispr (ctl-arrow-char-table) c r)
  133.    )
  134. c
  135. )
  136.  
  137. (defun standard-char-g1 (c sc)
  138.    "Display character C as G1 character SC in
  139.    backslash-char-table and ctl-arrow-char-table."
  140.    (let     ((r (vector (new-glyf (concat "\016" (char-to-string sc) "\017")))))
  141.       (put-char-table-dispr (backslash-char-table) c r)
  142.       (put-char-table-dispr (ctl-arrow-char-table) c r)
  143.       r
  144.    )
  145. )
  146.  
  147. (defun string-to-rope (s)
  148.    "Convert string S to a rope with 1 glyf for each character."
  149.    (let* (
  150.          (l (length s))
  151.          (r (make-vector l nil)) ; The rope.
  152.          (i 0)                   ; Index.
  153.          )
  154.       (while (/= i l)
  155.          (aset r i (get-glyf (char-to-string (aref s i))))
  156.          (setq i (1+ i))
  157.       )
  158.       r
  159.    )
  160. )
  161.  
  162. (defun toggle-ctl-arrow ()
  163.    "Toggle display of control characters in selected window."
  164.    (interactive)
  165.    (if (eq (window-char-table) (ctl-arrow-char-table))
  166.       (ctl-arrow-off)
  167.       (ctl-arrow-on)
  168.    )
  169. )
  170.  
  171. (defun toggle-default-ctl-arrow ()
  172.    "Toggle default display of control characters."
  173.    (interactive)
  174.    (if (eq (default-value 'buffer-char-table) (ctl-arrow-char-table))
  175.       (default-ctl-arrow-off)
  176.       (default-ctl-arrow-on)
  177.    )
  178. )
  179.  
  180. (provide 'char-table)
  181.